home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / interp / nlx.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  7.8 KB  |  296 lines  |  [TEXT/ttxt]
  1. /**********************************************************************\
  2. *
  3. *  Copyright (c) 1994  Carnegie Mellon University
  4. *  All rights reserved.
  5. *  
  6. *  Use and copying of this software and preparation of derivative
  7. *  works based on this software are permitted, including commercial
  8. *  use, provided that the following conditions are observed:
  9. *  
  10. *  1. This copyright notice must be retained in full on any copies
  11. *     and on appropriate parts of any derivative works.
  12. *  2. Documentation (paper or online) accompanying any system that
  13. *     incorporates this software, or any part of it, must acknowledge
  14. *     the contribution of the Gwydion Project at Carnegie Mellon
  15. *     University.
  16. *  
  17. *  This software is made available "as is".  Neither the authors nor
  18. *  Carnegie Mellon University make any warranty about the software,
  19. *  its performance, or its conformity to any specification.
  20. *  
  21. *  Bug reports, questions, comments, and suggestions should be sent by
  22. *  E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  23. *
  24. ***********************************************************************
  25. *
  26. * $Header: nlx.c,v 1.7 94/10/05 21:04:06 nkramer Exp $
  27. *
  28. * This file implements non-local exit.
  29. *
  30. \**********************************************************************/
  31.  
  32. #include "../compat/std-c.h"
  33.  
  34. #include "mindy.h"
  35. #include "gc.h"
  36. #include "thread.h"
  37. #include "func.h"
  38. #include "list.h"
  39. #include "bool.h"
  40. #include "obj.h"
  41. #include "sym.h"
  42. #include "class.h"
  43. #include "error.h"
  44. #include "def.h"
  45.  
  46. static obj_t obj_CatchBlockClass = 0;
  47.  
  48.  
  49. /* Unwind-protect. */
  50.  
  51. struct uwp {
  52.     obj_t prev_uwp;
  53.     obj_t handlers;
  54.     obj_t cleanup;
  55. };
  56.  
  57. static void done_with_cleanup(struct thread *thread, obj_t *cleanup_vals)
  58. {
  59.     obj_t *old_sp, *vals;
  60.  
  61.     /* Get the pointer to the values from the protected form from the stack.
  62.        We pushed it just before calling the cleanup, so it just below the
  63.        cleanup values. */
  64.     vals = obj_rawptr(cleanup_vals[-1]);
  65.  
  66.     /* Reset the stack to just after the protected form values. */
  67.     thread->sp = cleanup_vals - 1;
  68.  
  69.     /* Return those values. */
  70.     old_sp = pop_linkage(thread);
  71.     do_return(thread, old_sp, vals);
  72. }
  73.  
  74. static void do_uwp_cleanup(struct thread *thread, obj_t *vals)
  75. {
  76.     struct uwp *cur_uwp = thread->cur_uwp;
  77.  
  78.     /* Unlink the unwind protect */
  79.     thread->cur_uwp = obj_rawptr(cur_uwp->prev_uwp);
  80.  
  81.     /* push a pointer to the values. */
  82.     *thread->sp++ = rawptr_obj(vals);
  83.  
  84.     /* call the cleanup function. */
  85.     *thread->sp++ = cur_uwp->cleanup;
  86.     set_c_continuation(thread, done_with_cleanup);
  87.     invoke(thread, 0);
  88. }
  89.  
  90. static void uwp(struct thread *thread, int nargs)
  91. {
  92.     obj_t *args, *fp;
  93.     struct uwp *cur_uwp;
  94.  
  95.     assert(nargs == 2);
  96.  
  97.     args = thread->sp - 2;
  98.     fp = push_linkage(thread, args);
  99.     cur_uwp = (struct uwp *)fp;
  100.  
  101.     /* link in the new unwind protect */
  102.     thread->sp = fp + sizeof(struct uwp)/sizeof(obj_t);
  103.     cur_uwp->prev_uwp = rawptr_obj(thread->cur_uwp);
  104.     thread->cur_uwp = cur_uwp;
  105.     cur_uwp->handlers = thread->handlers;
  106.     cur_uwp->cleanup = args[1];
  107.  
  108.     /* call the protected form. */
  109.     *thread->sp++ = args[0];
  110.     set_c_continuation(thread, do_uwp_cleanup);
  111.     invoke(thread, 0);
  112. }
  113.  
  114.  
  115. /* Catch */
  116.  
  117. struct catch_block {
  118.     obj_t class;
  119.     struct thread *thread;
  120.     struct uwp *cur_uwp;
  121.     obj_t prev_catch;
  122.     obj_t *fp;
  123.     obj_t handlers;
  124. };
  125.  
  126. static void unlink_catch(struct thread *thread, obj_t *vals)
  127. {
  128.     obj_t catch_block;
  129.     obj_t *old_sp;
  130.  
  131.     /* Unlink and invalidate the current catch block. */
  132.     catch_block = thread->cur_catch;
  133.     thread->cur_catch = obj_ptr(struct catch_block *, catch_block)->prev_catch;
  134.     obj_ptr(struct catch_block *, catch_block)->thread = NULL;
  135.     obj_ptr(struct catch_block *, catch_block)->prev_catch = obj_False;
  136.  
  137.     /* Return the same values we got. */
  138.     old_sp = pop_linkage(thread);
  139.     do_return(thread, old_sp, vals);
  140. }
  141.  
  142. static void catch(struct thread *thread, int nargs)
  143. {
  144.     obj_t *args, *fp;
  145.     obj_t catch_block;
  146.  
  147.     assert(nargs == 1);
  148.  
  149.     args = thread->sp - 1;
  150.     fp = push_linkage(thread, args);
  151.  
  152.     catch_block = alloc(obj_CatchBlockClass, sizeof(struct catch_block));
  153.     obj_ptr(struct catch_block *, catch_block)->thread = thread;
  154.     obj_ptr(struct catch_block *, catch_block)->cur_uwp = thread->cur_uwp;
  155.     obj_ptr(struct catch_block *, catch_block)->prev_catch = thread->cur_catch;
  156.     obj_ptr(struct catch_block *, catch_block)->fp = fp;
  157.     obj_ptr(struct catch_block *, catch_block)->handlers = thread->handlers;
  158.     thread->cur_catch = catch_block;
  159.  
  160.     thread->sp = fp + 2;
  161.     fp[0] = args[0];
  162.     fp[1] = catch_block;
  163.     set_c_continuation(thread, unlink_catch);
  164.     invoke(thread, 1);
  165. }
  166.  
  167.  
  168. /* Throw */
  169.  
  170. static void unwind(struct thread *thread, obj_t catch_block, obj_t *vals);
  171.  
  172. static void throw(struct thread *thread, int nargs)
  173. {
  174.     obj_t *args;
  175.     obj_t catch_block;
  176.  
  177.     assert (nargs > 0);
  178.  
  179.     args = thread->sp - nargs;
  180.     catch_block = args[0];
  181.     if (obj_ptr(struct catch_block *, catch_block)->thread != thread) {
  182.     push_linkage(thread, args);
  183.     error("Bogus throw");
  184.     }
  185.  
  186.     unwind(thread, args[0], args+1);
  187. }
  188.  
  189. static void continue_unwind(struct thread *thread, obj_t *cleanup_vals)
  190. {
  191.     obj_t catch_block = cleanup_vals[-1];
  192.     obj_t *vals = thread->fp;
  193.  
  194.     thread->sp = cleanup_vals - 1;
  195.  
  196.     unwind(thread, catch_block, vals);
  197. }
  198.  
  199. static void unwind(struct thread *thread, obj_t catch_block, obj_t *vals)
  200. {
  201.     struct uwp *cur_uwp;
  202.     obj_t cur_catch;
  203.  
  204.     cur_uwp = thread->cur_uwp;
  205.  
  206.     do {
  207.     cur_catch = thread->cur_catch;
  208.     if (cur_uwp != obj_ptr(struct catch_block *, cur_catch)->cur_uwp) {
  209.         obj_t cleanup = cur_uwp->cleanup;
  210.         obj_t *dst = (obj_t *)cur_uwp;
  211.         obj_t *src = vals;
  212.         obj_t *end = thread->sp;
  213.  
  214.         /* Set the frame pointer to where the values will show up. */
  215.         thread->fp = dst;
  216.  
  217.         /* Restore the handlers, and unlink the uwp. */
  218.         thread->handlers = cur_uwp->handlers;
  219.         thread->cur_uwp = obj_rawptr(cur_uwp->prev_uwp);
  220.  
  221.         /* Copy the values down the stack, and save the catch block */
  222.         while (src < end)
  223.         *dst++ = *src++;
  224.         thread->sp = dst+2;
  225.         dst[0] = catch_block;
  226.  
  227.         /* call the cleanup function. */
  228.         dst[1] = cleanup;
  229.         set_c_continuation(thread, continue_unwind);
  230.         invoke(thread, 0);
  231.         return;
  232.     }
  233.     /* Unlink the catch block we just unwound past. */
  234.     obj_ptr(struct catch_block *, cur_catch)->thread = NULL;
  235.     thread->handlers = obj_ptr(struct catch_block *, cur_catch)->handlers;
  236.     thread->cur_catch=obj_ptr(struct catch_block *, cur_catch)->prev_catch;
  237.     } while (cur_catch != catch_block);
  238.  
  239.     /* Restore the frame pointer and the handlers. */
  240.     thread->fp = obj_ptr(struct catch_block *, cur_catch)->fp;
  241.     thread->handlers = obj_ptr(struct catch_block *, cur_catch)->handlers;
  242.  
  243.     /* And back we go. */
  244.     do_return(thread, pop_linkage(thread), vals);
  245. }
  246.  
  247.  
  248. /* GC stuff. */
  249.  
  250. static int scav_catch(struct object *o)
  251. {
  252.     struct catch_block *catch = (struct catch_block *)o;
  253.  
  254.     scavenge(&catch->prev_catch);
  255.     scavenge(&catch->handlers);
  256.  
  257.     return sizeof(struct catch_block);
  258. }
  259.  
  260. static obj_t trans_catch(obj_t catch)
  261. {
  262.     return transport(catch, sizeof(struct catch_block));
  263. }
  264.  
  265. void scavenge_nlx_roots(void)
  266. {
  267.     scavenge(&obj_CatchBlockClass);
  268. }
  269.  
  270.  
  271. /* Init stuff. */
  272.  
  273. void make_nlx_classes(void)
  274. {
  275.     obj_CatchBlockClass = make_builtin_class(scav_catch, trans_catch);
  276. }
  277.  
  278. void init_nlx_classes(void)
  279. {
  280.     init_builtin_class(obj_CatchBlockClass, "<catch>", obj_ObjectClass, NULL);
  281. }
  282.  
  283.  
  284. void init_nlx_functions(void)
  285. {
  286.     define_constant("uwp",
  287.             make_raw_function("uwp", 2, FALSE, obj_False, FALSE,
  288.                       obj_Nil, obj_ObjectClass, uwp));
  289.     define_constant("catch",
  290.             make_raw_function("catch", 1, FALSE, obj_False, FALSE,
  291.                       obj_Nil, obj_ObjectClass, catch));
  292.     define_constant("throw",
  293.             make_raw_function("throw", 1, TRUE, obj_False, FALSE,
  294.                       obj_Nil, obj_ObjectClass, throw));
  295. }
  296.